(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ") T) (LISPXPRIN1 (QUOTE 
"30-MAR-73 06:25:44") T) (LISPXTERPRI T))
(LISPXPRINT (QUOTE EDITSTRUCVARS) T)
(RPAQQ EDITSTRUCVARS ((P (PROGN (LISPXPRIN1 (QUOTE 
"*** TYPE  HELP-EDIT<CARRIAGE> FOR HELP") T) (LISPXTERPRI T))) (RECORD
MARKER-REC) (PROP RECDEFAULT MARKERS) (P (RPAQ EDITSTRUCTURE NIL))
(VARS EDITSTRUCCOMMANDS KNOWNSUPERATOMS DOTNOTATION EDITSTRUCMACROS)
(FNS ADDCOMMAND ADDDOTS ADDFV BONDEDP BONDORDER BREAKUP CHAIN COMPOSE4
CYCLE DELETESUPERATOM DOTS HELP-EDIT JOIN MERGESTRUCS NAME NEWSTRUCTURE
P PUTNEWNODE RECOGNIZEFN RECOGNIZEFN* REMOVEDOTS SATURATE SHOWIT 
UNSATURATE) (PROP RECDEFAULT DOTSFIELD) (P (/NCONC LISPXMACROS 
EDITSTRUCMACROS)) (P (/NCONC LISPXMACROS (MAPCAR KNOWNSUPERATOMS (
FUNCTION RECOGNIZEFN))))))
(PROGN (LISPXPRIN1 (QUOTE "*** TYPE  HELP-EDIT<CARRIAGE> FOR HELP")
T) (LISPXTERPRI T))
(DEFLIST(QUOTE(
(MARKER-REC (ATOMTYPE DOTSFIELD . OTHERMARKERS))
))(QUOTE RECORD))

(RECORD (QUOTE MARKER-REC))
(DEFLIST(QUOTE(
(MARKERS (NIL (DOT . 0)))
))(QUOTE RECDEFAULT))

(RPAQ EDITSTRUCTURE NIL)
(RPAQQ EDITSTRUCCOMMANDS (HELP-EDIT ADDFV HELLO NAMEIT P CYCLE CHAIN
SHOWIT JOIN NEW))
(RPAQQ KNOWNSUPERATOMS NIL)
(RPAQQ DOTNOTATION NIL)
(RPAQQ EDITSTRUCMACROS ((HELP-EDIT (PROG2 (APPLY (QUOTE HELP-EDIT)
LISPXLINE) (QUOTE DONE))) (ADDFV (PROG2 (APPLY (QUOTE ADDFV) (LIST
LISPXLINE)) (QUOTE DONE))) (P (PROG2 (APPLY (QUOTE P) LISPXLINE) (QUOTE
DONE))) (NAMEIT (PROG2 (APPLY (QUOTE NAME) LISPXLINE) (QUOTE DONE)))
(CYCLE (PROG2 (APPLY (QUOTE CYCLE) LISPXLINE) (QUOTE DONE))) (CHAIN
(PROG2 (APPLY (QUOTE CHAIN) LISPXLINE) (QUOTE DONE))) (SHOWIT (PROG2
(APPLY (QUOTE SHOWIT) LISPXLINE) (QUOTE DONE))) (JOIN (PROG2 (APPLY
(QUOTE JOIN) LISPXLINE) (QUOTE DONE))) (NEW (NEWSTRUCTURE))))
(DEFINEQ

(ADDCOMMAND
(LAMBDA (X) (SETQ EDITSTRUCCOMMANDS (CONS X EDITSTRUCCOMMANDS)) (SETQ
X (LIST X (LIST (QUOTE PROG2) (LIST (QUOTE APPLY) (KWOTE X) (QUOTE
LISPXLINE)) (KWOTE (QUOTE DONE))))) (SETQ EDITSTRUCMACROS (CONS X
EDITSTRUCMACROS)) (SETQ LISPXMACROS (CONS X LISPXMACROS)) "ADDED"))

(ADDDOTS
(LAMBDA (NODE NUMBER STRUC) (PROG (M) (SETQ M (DOTSFIELD (MARKERS
(FINDCTE NODE (OR STRUC EDITSTRUCTURE))))) (RPLACD M (PLUS (OR NUMBER
1) (OR (CDR M) 0))))))

(ADDFV
(LAMBDA (LL STRUC) (SETQ STRUC (OR STRUC EDITSTRUCTURE)) (FOR NEW
L IN LL DO (/RPLACD (CDR (CDR (FINDCTE L STRUC))) (/NCONC1 (NBRS (
FINDCTE L STRUC)) (QUOTE FV)))) (QUOTE DONE)))

(BONDEDP
(LAMBDA (N1 N2 STRUC) (MEMBER N2 (NBRS (FINDCTE N1 (OR STRUC 
EDITSTRUCTURE))))))

(BONDORDER
(LAMBDA (C1 C2) (PLUS (CONNECTIVITY (NODENUM C1) (NODENUM C2) 
EDITSTRUCTURE) (TIMES .5 (PLUS (DOTS (NODENUM C1)) (DOTS (NODENUM
C2)))))))

(BREAKUP
(LAMBDA (STRING) (PROG (ATOMS BONDLIST (N LASTNODE)) (FOR NEW X IN
(UNPACK STRING) DO (IF (NUMBERP X) THEN (SETQ BONDLIST (APPEND (FOR
NEW I := (2 X) XLIST (CONS N (ADD1 N))) BONDLIST)) ELSE (SETQ N (ADD1
N)) (SETQ ATOMS (CONS X ATOMS)))) (RETURN (CONS (DREVERSE ATOMS) 
BONDLIST)))))

(CHAIN
(LAMBDA (ARG) (PROG (STRUC LN) (SETQ LN (ADD1 LASTNODE)) (IF (NUMBERP
ARG) THEN (SETQ ARG (PACK (FOR I := (1 ARG) XLIST 'C)))) (IF (ATOM
ARG) THEN (PROG (A) (SETQ A (BREAKUP ARG)) (SETQ STRUC (BIVCHAIN (LENGTH
(CAR A)))) (FOR NEW X IN (CDR A) DO (UNSATURATE (CAR X) (CDR X) STRUC))
(FOR NEW CT IN (CTABLE OF STRUC) AS NEW ATOMNAME IN (DREVERSE (CAR
A)) DO (REPLACE (ATOMTYPE (MARKERS CT)) ATOMNAME)))) (IF (EQP LN 
LASTNODE) THEN (MAPRINT (LIST (QUOTE NODE) LN)) ELSE (MAPRINT (LIST
(QUOTE NODES) LN (QUOTE TO) LASTNODE))) (TERPRI) (/RPLACA (QUOTE 
EDITSTRUCTURE) (MERGESTRUCS STRUC)) (RETURN EDITSTRUCTURE))))

(COMPOSE4
(LAMBDA (FIELD) (COND ((NULL FIELD) NIL) ((ATOM FIELD) ((LAMBDA (X)
(COND (X (KWOTE X)))) (COPY (GETP FIELD (QUOTE RECDEFAULT))))) (T
(≠CONS (COMPOSE4 (CAR FIELD)) (COMPOSE4 (CDR FIELD)))))))

(CYCLE
(LAMBDA (ARG) (PROG (STRUC LN) (SETQ LN (ADD1 LASTNODE)) (SETQ STRUC
(CHAIN ARG)) (CONNECT (FINDCTE LN STRUC) (FINDCTE LASTNODE STRUC))
(RETURN STRUC))))

(DELETESUPERATOM
(LAMBDA (SUPAT) (SETQ KNOWNSUPERATOMS (DELETE SUPAT KNOWNSUPERATOMS))
(SETQ LISPXMACROS (FOR NEW M IN LISPXMACROS WHEN (NOT (EQ (CAR M)
SUPAT)) XLIST M)) (MAPCAR LISPXMACROS (QUOTE CAR))))

(DOTS
(LAMBDA (NODE STRUC) (CDR (DOTSFIELD (MARKERS (FINDCTE NODE (COND
((NOT STRUC) EDITSTRUCTURE) (STRUC))))))))

(HELP-EDIT
(LAMBDA (ARG) (IF (NOT ARG) THEN (TERPRI) (COND ((EQ (QUOTE YES) (RP
"HAVE YOU NEVER USED THE SYSTEM")) (PRINT 
"PLEASE TALK TO SRIDHARAN FOR PRELIMINARY INFORMATION") (MAPRINT (QUOTE
(THIS SYSTEM HELPS ONE TO USE THE COMPUTER ESSENTIALLY AS ONE'S BALL
AND STICK CHEMISTRY KIT ;))) (TERPRI) (MAPRINT (QUOTE (HOWEVER, THE
STICKS ARE MORE LIKE RUBBER BANDS FOR THE STRUCTURES ONE CREATES USING
THIS SYSTEM ARE TOPOLOGICAL IN CHARACTER RATHER THAN BEING GEOMETRICAL)))
(TERPRI) (MAPRINT (QUOTE (THERE ARE SIMPLE COMMANDS TO CREATE, CHANGE
AND SAVE STRUCTURES;))) (TERPRI) (PRINT 
"**** DO NOT HESITATE TO TRY ALL COMMANDS JUST 
     FOR FUN -- IF YOU DO NOT LIKE WHAT HAPPENS FREELY USE THE COMMAND
     'UNDO'.  AND HAVE FUN!"))) (PRINT 
"TO GET HELP ON ANY ONE COMMAND YOU MAY SUPPLY AN ARGUMENT
TO THE HELP-EDIT COMMAND") (TERPRI) (MAPRINT (QUOTE (TO FIND OUT THE
LIST OF KNOWN SUPERATOMS TYPE ←KNOWNSUPERATOMS))) (TERPRI) (TERPRI)
(MAPCAR EDITSTRUCCOMMANDS (FUNCTION (LAMBDA (CC) (PROGN (TERPRI) (PRIN1
CC) (SPACES 2) (PRINT (QUOTE :)) (TERPRI) (PRINT (COND ((GETP CC (QUOTE
EDITSTRUCEXPLAIN))) (T (QUOTE SORRY)))) (TERPRI))))) (TERPRI) (MAPRINT
(QUOTE (TYPING ANY VARIABLE WILL GIVE ITS VALUE))) (TERPRI) (MAPRINT
(QUOTE (SOME OF THE KEY VARIABLES ARE : KNOWNSUPERATOMS 
EDITSTRUCCOMMANDS EDITSTRUCTURE LASTNODE))) (TERPRI) (MAPRINT (QUOTE
(THE FOLLOWING COMMANDS ARE UNDOABLE : CYCLE CHAIN JOIN NAMEIT <NAME
OF ANY KNOWN SUPERATOM> ADDFV SATURATE UNSATURATE))) (TERPRI) (TERPRI)
ELSE (PRINT (COND ((GETP ARG (QUOTE EDITSTRUCEXPLAIN))) (T (QUOTE
SORRY)))) (TERPRI))))

(JOIN
(LAMBDA (N1 N2 STRING STRUC) (SETQ STRUC (COPY (OR STRUC EDITSTRUCTURE)))
(IF (AND (NUMBERP STRING) (NOT (NUMBERP N2))) THEN (SETQ TEMP N2)
(SETQ N2 STRING) (SETQ STRING TEMP)) (COND (STRING (PROG (NEWN1 NEWN2)
(SETQ NEWN1 (ADD1 LASTNODE)) (SETQ STRING (CHAIN STRING)) (SETQ NEWN2
LASTNODE) (CONNECT (FINDCTE N1 STRUC) (FINDCTE NEWN1 STRING)) (CONNECT
(FINDCTE N2 STRUC) (FINDCTE NEWN2 STRING)) (/RPLACA (QUOTE EDITSTRUCTURE)
STRING))) ((AND (NUMBERP N1) (NUMBERP N2)) (CONNECT (FINDCTE N1 STRUC)
(FINDCTE N2 STRUC)) (/RPLACA (QUOTE EDITSTRUCTURE) STRUC)) ((AND (NOT
(NUMBERP N2)) (ATOM N2)) (SETQ TEMP (ADD1 LASTNODE)) (SETQ STRUC (CHAIN
N2)) (JOIN N1 TEMP)) (T (ERROR "BAD ARGUMENTS TO JOIN")))))

(MERGESTRUCS
(LAMBDA (S1 S2) (SETQ S2 (OR S2 EDITSTRUCTURE)) (STRUCTURE CTABLE
= (APPEND (CTABLE S1) (CTABLE S2)) LASTNODE# = LASTNODE UGRAPH = (QUOTE
EDITSTRUCTURE))))

(NAME
(LAMBDA (IT X) (COND ((NOT X) (SETQ X IT))) (GSET X (STRUCTURE FROM
EDITSTRUCTURE UGRAPH = X)) (/RPLACA KNOWNSUPERATOMS (CONS X 
KNOWNSUPERATOMS)) (/NCONC LISPXMACROS (LIST (RECOGNIZEFN* X)))))

(NEWSTRUCTURE
(LAMBDA NIL (SETQ LASTNODE 0) (SETQ EDITSTRUCTURE (STRUCTURE UGRAPH
= (QUOTE NEW-STRUCTURE))) (QUOTE FINE)))

(P
(LAMBDA (XX) (PRINT (COND ((NOT XX) EDITSTRUCTURE) ((ATOM XX) (EVAL
XX)) (T XX)))))

(PUTNEWNODE
(LAMBDA (STRUC) (IF STRUC THEN (PROGN (SETQ LASTNODE (ADD1 (LASTNODE#
STRUC))) (STRUCTURE FROM STRUC CTABLE = (PUTNEWNODEINCT (CTENTRY NODENUM
= LASTNODE) (CTABLE OF STRUC)) LASTNODE# = LASTNODE)) ELSE (PROGN
(SETQ LASTNODE (ADD1 LASTNODE)) (STRUCTURE CTABLE = (LIST (CTENTRY
NODENUM = LASTNODE)) LASTNODE# = LASTNODE)))))

(RECOGNIZEFN
(LAMBDA (SUPAT) (PROG (SS) (SETQ SS (COPY SUPAT)) (RETURN (COND ((EQUAL
EDITSTRUCTURE (QUOTE (STRUCTURE NIL NEW-STRUCTURE NIL NIL))) (/RPLACA
(QUOTE EDITSTRUCTURE) SS) (/RPLACA (QUOTE LASTNODE) (LASTNODE# SS))
(QUOTE (NOW MADE EDITSTRUCTURE))) (T (PROGN (FOR NEW CT IN (CTABLE
OF SS) DO (REPLACE (NODENUM CT) (PLUS (NODENUM CT) LASTNODE)) (REPLACE
(NBRS CT) (FOR NEW N IN (NBRS CT) XLIST (PLUS N LASTNODE)))) (REPLACE
(LASTNODE# SS) (PLUS LASTNODE (LASTNODE# SS))) (/RPLACA (QUOTE LASTNODE)
(LASTNODE# SS)) (/RPLACA (QUOTE EDITSTRUCTURE) (MERGESTRUCS SS)) (QUOTE
(MERGED WITH WHAT YOU ALREADY HAVE)))))))))

(RECOGNIZEFN*
(LAMBDA (SUPAT) (LIST SUPAT (LIST (QUOTE RECOGNIZEFN) SUPAT))))

(REMOVEDOTS
(LAMBDA (NODE NUMBER STRUC) (PROG (M) (SETQ STRUC (OR STRUC 
EDITSTRUCTURE)) (SETQ NUMBER (OR NUMBER 1)) (SETQ M (DOTSFIELD (MARKERS
(FINDCTE NODE STRUC)))) (RPLACD M (DIFFERENCE (CDR M) NUMBER)))))

(SATURATE
(LAMBDA (N1 N2 STRUC) (SETQ STRUC (OR STRUC EDITSTRUCTURE)) (COND
(DOTNOTATION (REMOVEDOTS N1 1 STRUC) (REMOVEDOTS N2 1 STRUC)) (T (
DISJOIN N1 N2 NIL STRUC)))))

(SHOWIT
(LAMBDA (FLAG) (COND (FLAG (DRAW (STRUCTURE FROM EDITSTRUCTURE CTABLE
= (MAPCAR (CTABLE EDITSTRUCTURE) (F/L (X) (SETQ X (COPY X)) (REPLACE
(ATOMTYPE (MARKERS X)) (NODENUM X)) X))))) (T (DRAW EDITSTRUCTURE)))
T))

(UNSATURATE
(LAMBDA (N1 N2 STRUC) (SETQ STRUC (OR STRUC EDITSTRUCTURE)) (COND
(DOTNOTATION (ADDDOTS N1 1 STRUC) (ADDDOTS N2 1 STRUC)) (T (CONNECT
(FINDCTE N1 STRUC) (FINDCTE N2 STRUC))))))
)
(DEFLIST(QUOTE(
(DOTSFIELD (DOTS . 0))
))(QUOTE RECDEFAULT))

(/NCONC LISPXMACROS EDITSTRUCMACROS)
(/NCONC LISPXMACROS (MAPCAR KNOWNSUPERATOMS (FUNCTION RECOGNIZEFN)))
STOP